home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / ada / adaed-1.11 / adaed-1 / Adaed-1.11.0a / 11.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-02-07  |  3.9 KB  |  163 lines
  1. /*
  2.  * Copyright (C) 1985-1992  New York University
  3.  * 
  4.  * This file is part of the Ada/Ed-C system.  See the Ada/Ed README file for
  5.  * warranty (none) and distribution info and also the GNU General Public
  6.  * License for more details.
  7.  
  8.  */
  9. #include "hdr.h"
  10. #include "vars.h"
  11. #include "smiscprots.h"
  12. #include "miscprots.h"
  13. #include "setprots.h"
  14. #include "errmsgprots.h"
  15. #include "chapprots.h"
  16.  
  17. void except_decl(Node id_list_node)                            /*;except_decl*/
  18. {
  19.     Node    id_node;
  20.     Symbol    name;
  21.     Fortup    ft1;
  22.  
  23.     if (cdebug2 > 3) TO_ERRFILE("AT PROC :  except_decl");
  24.  
  25.     FORTUP(id_node = (Node), N_LIST(id_list_node), ft1);
  26.         name = find_new(N_VAL(id_node));
  27.         N_UNQ(id_node) = name;
  28.         NATURE(name) = na_exception;
  29.         TYPE_OF(name) = symbol_exception;
  30.     ENDFORTUP(ft1);
  31. }
  32.  
  33. void exception_part(Node node)                            /*;exception_part*/
  34. {
  35.     Symbol    handler;
  36.  
  37.     if (cdebug2 > 3) TO_ERRFILE("AT PROC :  exception_part'");
  38.  
  39.     /* A scope is established for the exception handlers. This scope
  40.      * or a block nested within it, are the only valid scopes for the
  41.      * occurence of a non-specific RAISE statement.
  42.      */
  43.  
  44.     handler = find_new(newat_str());
  45.     newscope(handler);
  46.     /*SYMBTAB(handler) := [na_block, 'handler', []];*/
  47.     NATURE(handler) = na_block;
  48.     OVERLOADS(handler) = (Set) BLOCK_HANDLER;
  49.     SIGNATURE(handler) = tup_new(0);
  50.  
  51.     /* Process individual handlers.*/
  52.     sem_list(node);
  53.  
  54.     popscope();
  55. }
  56.  
  57. void exception_handler(Node node)                    /*;exception_handler*/
  58. {
  59.     Node    excp_list_node, statements_node, name_node;
  60.     Tuple    exception_list;
  61.     Symbol    except;
  62.     Fortup    ft1;
  63.  
  64.     if (cdebug2 > 3) TO_ERRFILE("AT PROC :  exception_handler");
  65.  
  66.     excp_list_node = N_AST1(node);
  67.     statements_node = N_AST2(node);
  68.     exception_list = N_LIST(excp_list_node);
  69.     FORTUP(name_node = (Node), exception_list, ft1);
  70.         adasem(name_node);
  71.  
  72.         if (N_KIND(name_node) != as_others) {
  73.             find_old(name_node);
  74.             except = N_UNQ(name_node);
  75.             if (NATURE(except) != na_exception) {
  76. #ifdef ERRNUM
  77.                 id_errmsgn(23, except, 24, name_node);
  78. #else
  79.                 errmsg_id("% is not an exception", except, "11.1", name_node);
  80. #endif
  81.             }
  82.             else if (tup_mem((char *) except, SIGNATURE(scope_name)) ) {
  83. #ifdef ERRNUM
  84.                 errmsgn(25, 26, name_node);
  85. #else
  86.                 errmsg("Duplicate exception name in handler", "11.2",name_node);
  87. #endif
  88.             }
  89.             else {
  90.                 SIGNATURE(scope_name) = tup_with(SIGNATURE(scope_name),
  91.                   (char *) except);
  92.             }
  93.         }
  94.         else {
  95.             /* The use of 'others' in SETL is just as a marker for local
  96.              * processing. Use the null symbol pointer in C version.
  97.              */
  98.             if (tup_mem((char *)0, SIGNATURE(scope_name)) ) {
  99. #ifdef ERRNUM
  100.                 errmsgn(27, 26, name_node);
  101. #else
  102.                 errmsg("Duplicate OTHERS in exception part", "11.2", name_node);
  103. #endif
  104.             }
  105.             else if (tup_size(exception_list) == 1)
  106.                 SIGNATURE(scope_name) = tup_with(SIGNATURE(scope_name),
  107.                   (char *)0);
  108.         }
  109.     ENDFORTUP(ft1);
  110.  
  111.     adasem(statements_node);
  112. }
  113.  
  114. void raise_statement(Node node)                            /*;raise_statement*/
  115. {
  116.     Node    name_node;
  117.     Symbol    scope, except;
  118.     int    exists;
  119.     Fortup    ft1;
  120.  
  121.     if (cdebug2 > 3) TO_ERRFILE("AT PROC :  raise_statement");
  122.  
  123.     name_node = N_AST1(node);
  124.  
  125.     if (name_node == OPT_NODE) {
  126.         /* Non-specific raise. This statement form can appear only within
  127.          * an exception handler.
  128.          */
  129.         exists = FALSE;
  130.  
  131.         FORTUP(scope = (Symbol), open_scopes, ft1);
  132.             if(NATURE(scope) != na_block
  133.               || (int)OVERLOADS(scope) == BLOCK_HANDLER) {
  134.                 exists = TRUE;
  135.                 break;
  136.             }
  137.         ENDFORTUP(ft1);
  138.         if (!exists) chaos("assert error in raise_statement");
  139.  
  140.         if ((int)OVERLOADS(scope) != BLOCK_HANDLER) {
  141. #ifdef ERRNUM
  142.             errmsgn(28, 29, node);
  143. #else
  144.             errmsg("RAISE statement not directly in exception handler", "11.3",
  145.               node);
  146. #endif
  147.         }
  148.     }
  149.     else {
  150.         adasem(name_node);
  151.         find_old(name_node);
  152.         except = N_UNQ(name_node);
  153.         if ( except == (Symbol)0
  154.           || NATURE(except) != na_exception && TYPE_OF(except) != symbol_any) {
  155. #ifdef ERRNUM
  156.             errmsgn(30, 24, name_node);
  157. #else
  158.             errmsg("Invalid exception name", "11.1", name_node);
  159. #endif
  160.         }
  161.     }
  162. }
  163.